home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / util / rexx / FWCalendar.lha / gui4cli.lha / Gui4Cli / Tools / Palette.gc < prev    next >
Encoding:
Gui4CLI script  |  1998-07-06  |  6.7 KB  |  247 lines

  1. G4C
  2.  
  3. ; Palette.gc by D.Keletsekis & J.Collett
  4. ; ---------------------------------------------------------------
  5. ; A full palette gui with many capabilities
  6. ; Press CONTROL-J to make it jump screens
  7. ; ---------------------------------------------------------------
  8.  
  9. winbig -1 -1 235 120 'Palette'
  10. wintype 11110001
  11.  
  12. box 0 0 0 0 out button
  13.  
  14. ; ---------------------------------------------------------------
  15. ;    system events
  16. ; ---------------------------------------------------------------
  17.  
  18. xonload
  19. guiopen palette.gc
  20.  
  21. xonopen
  22. info palette palette.gc/5    ; get info on *our* platte
  23. type = 'update'            ; set the subroutine type
  24. gosub palette.gc update        ; Subroutine
  25.  
  26. xonRMB        
  27. ; on rmb we update to the color under mouse position
  28. update palette.gc 5 $$mouse.color
  29. ; and update since we did not click on the palette
  30. gosub palette.gc update
  31.  
  32. xonclose
  33. guiquit palette.gc
  34.  
  35. ; ---------------------------------------------------------------
  36. ;    palette & sliders
  37. ; ---------------------------------------------------------------
  38.  
  39. xPalette 10 5 225 30
  40. gadid 5
  41. gadhelp 'Click on a color, (or click RMB anywhere else)'
  42. gosub palette.gc $type
  43.  
  44. xHSlider 40 40 160 12 R red 0 15 0 %2ld
  45. gadhelp "Adjust RED intensity"
  46. setcolor palette.gc $$color.num $red $green $blue
  47. gadid 1
  48.  
  49. xHSlider 40 52 160 12 G green 0 15 0 %2ld
  50. gadhelp "Adjust GREEN intensity"
  51. setcolor palette.gc $$color.num $red $green $blue
  52. gadid 2
  53.  
  54. xHSlider 40 64 160 12 B blue 0 15 0 %2ld
  55. gadhelp "Adjust BLUE intensity"
  56. setcolor palette.gc $$color.num $red $green $blue
  57. gadid 3
  58.  
  59.  
  60. ; ---------------------------------------------------------------
  61. ;    routine to update sliders & get variables
  62. ; ---------------------------------------------------------------
  63.  
  64. xRoutine update
  65. ; get the current values from internal variables
  66. red   = $$color.r
  67. green = $$color.g
  68. blue  = $$color.b
  69. num   = $$color.num
  70. total = $$color.total
  71.  
  72. oldred   = $red        ; store old values for undo
  73. oldgreen = $green
  74. oldblue  = $blue
  75.  
  76. update palette.gc 1 $red    ; Update sliders
  77. update palette.gc 2 $green
  78. update palette.gc 3 $blue
  79.  
  80. setwintitle palette.gc 'Palette color $num of $total'
  81.  
  82.  
  83. ; ---------------------------------------------------------------
  84. ;    Undo button
  85. ; ---------------------------------------------------------------
  86.  
  87. xbutton 10 85 70 14 Undo     ; undo last changes
  88. setcolor palette.gc $$color.num $oldred $oldgreen $oldblue
  89. gosub palette.gc update
  90.  
  91.  
  92. ; ---------------------------------------------------------------
  93. ;    Load a previously saved palette 
  94. ;    (i.e. a normal GUI with a list of setcolor commands)
  95. ; ---------------------------------------------------------------
  96.  
  97. xbutton  80 85 70 14 Load..
  98. gadhelp "Load a previously saved gui, which sets the palette."
  99. filename = ''
  100. ReqFile -1 -1 300 -40 'Load Palette gui:' LOAD filename 'GUIs:tools/palette'
  101. if $filename > ' '
  102.    if $filename H= "G4C"
  103.       guiload $filename palette.gc    ; pass our gui name as argument
  104.       update palette.gc 5 1        ; go back to color No 1
  105.       info palette palette.gc/5        ; get info on palette
  106.       gosub palette.gc update        ; redraw the sliders etc
  107.    else
  108.       ezreq 'Please choose a Gui4Cli script pallete' OK ''
  109.    endif
  110. endif
  111.  
  112.  
  113. ; ---------------------------------------------------------------
  114. ;    Save a palette
  115. ;    make a loop and write a gui to set all colors
  116. ; ---------------------------------------------------------------
  117.  
  118. xbutton  150 85 70 14 Save..
  119. gadhelp "Save the current palette as a Gui."
  120. filename = ''
  121. ReqFile -1 -1 300 -40 'Save Palette as:' SAVE filename 'Guis:tools/palette'
  122. if $filename = ''
  123.    stop
  124. endif
  125. guiwindow palette.gc wait
  126. setwintitle palette.gc 'Saving Palette...'
  127. info palette palette.gc/5       ; make sure we're talcking about *our* palette
  128. .palette = 'G4C\n\n;Palette\n\nxOnLoad gui\n'
  129. count = 0
  130. while $count < $total
  131.     update palette.gc 5 $count  ; choose each colors in sequence
  132.     append env:.palette 'setcolor \$gui $count $$color.r $$color.g $$color.b\n'
  133.     ++count
  134. endwhile
  135. extract filename file guiname
  136. append env:.palette 'guiquit $guiname\n'
  137. copy env:.palette $filename
  138. delete env:.palette
  139. guiwindow palette.gc resume
  140. update palette.gc 5 1
  141. info palette palette.gc/5
  142. gosub palette.gc update
  143.  
  144.  
  145. ; ---------------------------------------------------------------
  146. ;     Copy, Exchange, Spread buttons
  147. ; ---------------------------------------------------------------
  148.  
  149. xbutton  10 100 70 14 Copy
  150. gosub palette.gc fixvalues
  151. type = 'copy'
  152.  
  153. xbutton  80 100 70 14 Exchange
  154. gosub palette.gc fixvalues
  155. type = 'exchange'
  156.  
  157. xbutton  150 100 70 14 Spread
  158. gosub palette.gc fixvalues
  159. type = 'spread'
  160.  
  161. ; store the current values in undo since we'll need them
  162. xRoutine fixvalues
  163. oldred   = $red
  164. oldgreen = $green
  165. oldblue  = $blue
  166.  
  167. ; ---------------------------------------------------------------
  168. ;    routine to copy values
  169. ; ---------------------------------------------------------------
  170.  
  171. xRoutine copy
  172. ;Set new colour to old values
  173. setcolor palette.gc $$color.num $oldred $oldgreen $oldblue
  174. type = 'update'        ; Reset routine flag
  175. setwintitle palette.gc 'Copied color $num to $$color.num'
  176. num = $$color.num
  177. update palette.gc 5 $num
  178. gosub palette.gc update
  179.  
  180.  
  181. ; ---------------------------------------------------------------
  182. ;    routine to exchange values
  183. ; ---------------------------------------------------------------
  184.  
  185. xRoutine exchange
  186. pal.on = $num       ; Store existing colour number
  187. red = $$color.r     ; get new values  
  188. green = $$color.g
  189. blue = $$color.b
  190. num = $$color.num
  191. ;Set each colour to other values
  192. setcolor palette.gc $num  $oldred $oldgreen $oldblue
  193. setcolor palette.gc $pal.on  $red $green $blue
  194. type = 'update'             ; Reset routine flag
  195. ; Update window title
  196. setwintitle palette.gc 'Exchanged colors $pal.on and $num'
  197. update palette.gc 5 $num
  198. gosub palette.gc update
  199.  
  200.  
  201. ; ---------------------------------------------------------------
  202. ;    Routine to do the spreading.
  203. ; ---------------------------------------------------------------
  204.  
  205. xROUTINE spread 
  206. ; use local variables..
  207. local col2/r2/g2/b2/rstep/gstep/bstep/sign/colnum/r/g/b
  208. ; get the 2nd color values
  209. col2 = $$color.num
  210. r2   = $$color.r 
  211. g2   = $$color.g
  212. b2   = $$color.b
  213.  
  214. ; if there is no spread, return
  215. if $(abs($num - $col2)) <= 1
  216.    return
  217. endif
  218.  
  219. ; which direction are we going
  220. sign = 1
  221. if $num > $col2
  222.    sign = -1
  223. endif
  224.  
  225. ; how many colors are we spreading ?
  226. colnum = $(abs($col2 - $num) - 1)
  227.  
  228. ; work out the change step for each color
  229. rstep  = $(($r2 - $oldred)   / $colnum) 
  230. gstep  = $(($g2 - $oldgreen) / $colnum) 
  231. bstep  = $(($b2 - $oldblue)  / $colnum) 
  232.  
  233. ; set all colors
  234. count = 0
  235. while $count < $colnum
  236.    ++count
  237.    ; use == so we get integers (should add trunc(x) function)
  238.    r == $($oldred   + ($count * $rstep)) * 1
  239.    g == $($oldgreen + ($count * $gstep)) * 1
  240.    b == $($oldblue  + ($count * $bstep)) * 1
  241.    setcolor palette.gc $($num + ($count * $sign)) $r $g $b
  242. endwhile
  243.  
  244. type = 'update'             ; Reset routine flag
  245. gosub palette.gc update
  246.  
  247.